home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 5
/
Apprentice-Release5.iso
/
Source Code
/
Libraries
/
SAT 2.3.8
/
Demos
/
HeartQuest demo ƒ
/
main.p
< prev
next >
Wrap
Text File
|
1996-05-23
|
13KB
|
400 lines
{================================================}
{=============== HeartQuest main unit ================}
{================================================}
{ Example file for Ingemars Sprite Animation Toolkit. }
{ © Ingemar Ragnemalm 1992 }
{ See doc files for legal terms for using this code. }
{ HeartQuest is a very simple game demonstrating how to use the Sprite Animation}
{ Toolkit. I originally wrote the game as my present to my wife Eva for Valentine's}
{ day 1992. You can still tell that this file once started as the Skel example in the}
{ TransSkel package by Paul DuBois and Owen Hartnett. }
{ This "main" file is rather small, and holds very little game specific code.}
{ Its main concern is to initialize the various parts of the game, and to hold the}
{ file and edit menu handlers. }
program HeartQuest;
uses
{$IFC UNDEFINED THINK_PASCAL}
Types, Quickdraw, Events, Windows, Resources, Fonts, {}
Menus, Memory, QuickDrawText, Errors, OSUtils, EPPC,
{$ENDC}
TransSkel, SAT, GameGlobals, GameWindow, {sound,}
SoundConst, scores, CenterStuff, Preferences, AppleEvents, ClutFade;
{Variables for the main program}
var
keys: KeyMap;
zoomFlag: Boolean;
ignore: longint; {For UnloadScrap error}
gAppleEventsInitialized: Boolean; {For initializing Apple Events when necessary}
{ -------------------------------------------------------------------- }
{ Menu handling procedures }
{ -------------------------------------------------------------------- }
{ Handle selection of "About…" item from Apple menu}
procedure DoAbout;
var
ignore: integer;
begin
ignore := DoAlert(43, aboutAlrt, nil);
end;
{ Process selection from File menu.}
{ HelpEnemies Shows a help box. }
{ Quit Request a halt by calling SkelHalt(). This makes SkelMain}
{ return.}
procedure DoFileMenu (item: integer);
var
ignore: integer;
begin
case item of
helpenemies:
ignore := DoAlert(43, helpenemiesAlrt, nil);
quit:
begin
if pauseFlag then
DoGameOver;
SkelWhoa;
end;
otherwise
;
end;
end;
procedure DoEditMenu;
begin
end;
{ Initialize menus. Tell TransSkel to process the Apple menu}
{ automatically, and associate the proper procedures with the}
{ File and Edit menus.}
procedure SetUpMenus;
begin
SkelApple(MyGetIndString(aboutStrID), @DoAbout); {string 1: About HeartQuest…}
fileMenu := GetMenu(fileMenuRes);
editMenu := GetMenu(editMenuRes);
GameMenu := GetMenu(GameMenuRes);
highMenu := GetMenu(highMenuRes);
dummy := SkelMenu(fileMenu, @DoFileMenu, nil, false);
dummy := SkelMenu(editMenu, @DoEditMenu, nil, false);
dummy := SkelMenu(GameMenu, @DoGameMenu, nil, false);
dummy := SkelMenu(highMenu, @DoHighMenu, nil, true);
end;
{ Initialize settings resources. These are saved in the game file itself. This is elegant,}
{ but a bit "server-hostile". An alternative is to create a preference file in the system}
{ folder. The routine determining where preferences should be saved, in Preferences.p,}
{ has a parameter that can be set to always save in a preference file, if you prefer that.}
procedure InitSettings;
begin
UseResFile(gPrefFile); {set the resfile to the pref file, if any. If none, gPrefFile will be the app itself!}
features := featHnd(GetResource('Feat', 0)); { Load the settings }
if features = nil then { Settings doesn't exist; create new }
begin
features := featHnd(NewHandle(Sizeof(featRec)));
CheckNoMem(Ptr(features));
features^^.sound := true;
features^^.allowBG := false;
features^^.player := MyGetIndString(anonymousStrID); {str 2: Anonymous}
features^^.macho := false;
AddResource(handle(features), 'Feat', 0, 'Settings');
end
else {Did exist - check the size!}
if GetHandleSize(Handle(features)) < sizeof(featHnd) then
SetHandleSize(Handle(features), sizeof(featHnd));
UseResFile(gAppFile);
{ Fix all checkmarks in the menus }
if features^^.sound then
begin
features^^.sound := false;
DoGameMenu(sound);
end
else
begin
features^^.sound := true;
DoGameMenu(sound);
end;
if features^^.macho then
begin
features^^.macho := false;
DoGameMenu(macho);
end
else
begin
features^^.macho := true;
DoGameMenu(macho);
end;
if features^^.PlotFast then
begin
features^^.PlotFast := false;
DoGameMenu(FastAnimation);
end
else
begin
features^^.PlotFast := true;
DoGameMenu(FastAnimation);
end;
if features^^.allowBG then
begin
features^^.allowBG := false;
DoGameMenu(allowBG);
end
else
begin
features^^.allowBG := true;
DoGameMenu(allowBG);
end;
end;
{ ******* MultiFinder and Apple events: ******* }
{MultiFinder events - suspend and reume - have been handled by HeartQuest since very early versions,}
{since I want it to hide its window when switched out.}
{AppleEvents are added, mostly because I wanted to learn about it. I learned one thing: Apple Events are}
{tedious. I tried simplifying AppleEvent support by installing my handlers first after getting an Apple}
{Event (getting rid of all checking for its existence - if it sends events to me, it exists) - but the interface}
{files needed are horrible. To speed up compilation, I made a stripped down interface file, HQAE.p.}
{All I really got by supporting Apple Events is that I can quit after getting the 'quit' Apple event.}
{Handle the required Apple events:}
{DoOpenApp,DoOpenDoc,DoPrintDoc,DoQuitApp}
{MyGotRequiredParams: From MSG demo my Mark Pilgrim, tells whether we have handled all we have to or not.}
function MyGotRequiredParams (theAppleEvent: AppleEvent): OSErr;
var
returnedType: DescType;
actualSize: Size;
begin
if AEGetAttributePtr(theAppleEvent, keyMissedKeywordAttr, typeWildCard, returnedType, nil, 0, actualSize) = errAEDescNotFound then
MyGotRequiredParams := noErr
else
MyGotRequiredParams := errAEParamMissed;
end;
function DoOpenApp (theAppleEvent, reply: AppleEvent; refCon: Longint): OSErr;
begin
{What am I supposed to do here?}
DoOpenApp := MyGotRequiredParams(theAppleEvent);
end;
function DoOpenDoc (theAppleEvent, reply: AppleEvent; refCon: Longint): OSErr;
begin
DoOpenDoc := errAEEventNotHandled; {We don't open any documents!}
end;
function DoPrintDoc (theAppleEvent, reply: AppleEvent; refCon: Longint): OSErr;
begin
DoPrintDoc := errAEEventNotHandled; {We don't print any documents!}
end;
function DoQuitApp (theAppleEvent, reply: AppleEvent; refCon: Longint): OSErr;
begin
SkelWhoa; {If I'm told to quit, I'll quit.}
DoQuitApp := MyGotRequiredParams(theAppleEvent);
end;
{Init Apple events}
{Perhaps I'm cheating, but I don't call this until I get the first Apple event.}
{IMHO, that's the simplest way to support them without a lot of boring Gestalt checks.}
procedure AppleEventInit;
var
error: OSerr;
begin
if gAppleEventsInitialized then
exit(AppleEventInit);
gAppleEventsInitialized := true;
error := AEInstallEventHandler(kCoreEventClass, kAEOpenApplication, @DoOpenApp, 0, false);
error := AEInstallEventHandler(kCoreEventClass, kAEOpenDocuments, @DoOpenDoc, 0, false);
error := AEInstallEventHandler(kCoreEventClass, kAEPrintDocuments, @DoPrintDoc, 0, false);
error := AEInstallEventHandler(kCoreEventClass, kAEQuitApplication, @DoQuitApp, 0, false);
{I ignore errors.}
end;
{Event processing that TransSkel nowadays HAS support for:}
{MultiFinder events: Hide gameWindow on suspend, so the user can get access to disk icons etc.}
{Apple Events: Handle the required Apple events.}
procedure DoSuspendResume (b: Boolean);
begin
if b then
{Resume event: show game window and set the sleep time to something fairly low}
begin
ShowWindow(gSAT.wind.port);
SelectWindow(gSAT.wind.port);
SkelSetSleep(5);
end
else
{Suspend event: Hide the game window and set the sleep time to something high}
{(Not that the sleep time matters when "can background" is false, but I put it in for demonstrating it.)}
begin
HideWindow(gSAT.wind.port);
SkelSetSleep(60);
end;
end;
function DoEvt (e: eventRecord): boolean;
begin
{In older versions, we handled Apple events and suspend/resume events here. Since then,}
{I have added support for them in TransSkel.p, so now this is only used for installing our}
{Apple Event handlers upon acceptance of the first Apple Event.}
{Old obsolete code: Handle suspend/resume events}
{if e.what = OSevt then}
{begin}
{if BAND(BROTL(e.message, 8), $FF) = SuspendResumeMessage then}
{DoSuspendResume(BAnd(e.message, 1) <> 0);}
{DoEvt := true;}
{end}
{else}
DoEvt := false; {We never actually PROCESS any event here!}
if e.what = kHighLevelEvent then
if not gAppleEventsInitialized then {My little "cheat" into compatibility}
AppleEventInit;
{if AEProcessAppleEvent(e) <> noErr then}
end; { DoEvt }
procedure EmergencyExit;
begin
{Fade back in on emergency exits, so we don't leave the screen faded!}
FadeScreen(1, false, fadeTo);
end; {EmergencyExit}
var
loadWind: WindowPtr;
procedure ShowLoadWind;
var
s: Str255;
fontNum: Integer;
world: SysEnvRec;
tempColorFlag: Boolean;
height, width: Integer;
begin
tempColorFlag := false;
if noErr = SysEnvirons(1, world) then
if world.hasColorQd then
tempColorFlag := true;
{$IFC UNDEFINED THINK_PASCAL}
if tempColorFlag then
loadWind := NewCWindow(nil, qd.screenBits.bounds, '', true, plainDBox, WindowPtr(-1), false, 0)
else
loadWind := NewWindow(nil, qd.screenBits.bounds, '', true, plainDBox, WindowPtr(-1), false, 0);
{$ELSEC}
if tempColorFlag then
loadWind := NewCWindow(nil, screenBits.bounds, '', true, plainDBox, WindowPtr(-1), false, 0)
else
loadWind := NewWindow(nil, screenBits.bounds, '', true, plainDBox, WindowPtr(-1), false, 0);
{$ENDC}
{Up with the loading window and draw SOMETHING}
SetPort(loadWind);
{Paint the window pink}
if tempColorFlag then
RGBForeColor(fadeTo);
PaintRect(loadWind^.portRect);
{Select 24-point Geneva}
TextSize(24);
TextFace([bold]);
GetFNum('Geneva', fontNum);
TextFont(fontNum);
{Get the loading string and draw it}
s := MyGetIndString(loadingStrID);
height := loadWind^.portRect.bottom - loadWind^.portRect.top;
width := loadWind^.portRect.right - loadWind^.portRect.left;
MoveTo(width div 2 - StringWidth(s) div 2, height div 2);
ForeColor(redColor);
DrawString(s);
ForeColor(blackColor);
end; {ShowLoadWind}
{ -------------------------------------------------------------------- }
{ Main }
{ -------------------------------------------------------------------- }
var
r: Rect;
begin
SkelInit(6, nil); { initialize }
SetUpMenus; { install menu handlers }
SetCursor(GetCursor(watchCursor)^^);
{Is the user holding down a modifier key? If so, we should use the whole screen.}
GetKeys(keys);
zoomFlag := keys[55] or keys[56] or keys[58] or keys[59]; {cmd, shift, alt, ctrl}
{Tell SAT that we want it to rescale the PICTs}
SATConfigure(true, kVPositionSort, kKindCollision, 32);
{Send strings from resources to SAT, so the program can be localized.}
SATSetStrings(MyGetIndString(okStrID), MyGetIndString(yesStrID), MyGetIndString(noStrID), MyGetIndString(quitStrID), MyGetIndString(memerrStrID), MyGetIndString(noscreenStrID), MyGetIndString(satnopictStrID), MyGetIndString(nowindStrID));
{Before fading, set the emergency exit routine to one where we restore the screen!}
SATInstallEmergency(@EmergencyExit);
fadeTo.red := -1;
fadeTo.green := $a000;
fadeTo.blue := $a000;
FadeScreen(30, true, fadeTo);
ShowLoadWind;
FadeScreen(30, false, fadeTo);
{ Initialize the Sprite Animation Toolkit, set up offscreen buffers and make the window. }
if zoomFlag then {if cmd, shift, alt, ctrl}
SetRect(r, 0, 0, 32000, 32000) {Very big - makes SAT cut it down to the main screen.}
else
SetRect(r, 0, 0, 512, 342); {Standard size}
SATCustomInit(132, 133, r, nil, nil, true, true, true, true, true);
{Here we can call SATSoundInitChannels if we want more than one channel.}
if SATSoundInitChannels(2) < 2 then
;
SATPreloadChannels;
{ Init all the different parts of the game. }
GameWindInit; { Init the game window }
{ Initialize the sprites }
InitSprites;
{We draw some of the background -the trees - ourselves in this game.}
DrawBackground;
FadeScreen(30, true, fadeTo);
{ Draw the contents of the window (to give the user something to look at during the rest of startup). }
DisposeWindow(loadWind);
ShowWindow(gSAT.wind.port);
SelectWindow(gSAT.wind.port);
HQRedraw;
FadeScreen(30, false, fadeTo);
Loadsounds; { preload all sound resources }
InitScores; { Init the score module, check if a pref file should be created }
InitSettings; { Load the settings }
{ Set the randseed to something that is random enough. }
{$IFC UNDEFINED THINK_PASCAL}
qd.randSeed := TickCount;
{$ELSEC}
randSeed := TickCount;
{$ENDC}
SkelEventHook(@DoEvt); { handle MultiFinder-events }
SkelSetSuspendResume(@DoSuspendResume); {NEW call in my version of TransSkel 2.0}
InitCursor;
SkelMain; { loop 'til Quit selected }
SkelClobber; { clean up }
SATSoundShutUp; { Terminate sounds }
end.